perm filename GENPAT.NEW[PAT,LMM] blob
sn#044098 filedate 1973-05-18 generic text, type T, neo UTF8
(FILECREATED "18-MAY-73 5:40:33" GENPAT.NEW)
(DEFINEQ
(COLLECT
[LAMBDA (FILE)
(/SET (QUOTE CURRENTFILE)
FILE)
(AND FILE
(PROGN (AND (NOT (FMEMB FILE FILELST))
(/SET (QUOTE FILELST)
(CONS FILE FILELST)))
[OR (EQ (CAAAR (SETQ FILE (FILEVARS FILE)))
(QUOTE FNS))
(/SET FILE (CONS (LIST (QUOTE FNS))
(COND
[(EQ (CAR FILE)
(QUOTE NOBIND))
(LIST (LIST (QUOTE VARS]
(T (CAR FILE]
CURRENTFILE])
(LISTFILE
[LAMBDA (FIL LFHOST LFLOGIN)
(BKSYSBUF (CONCAT "FTP
" [SETQ LFHOST (OR LFHOST HOST (SETQ HOST (PROGN (PRIN1 "HOST? ")
(READ T]
"
LOG "
[OR LFLOGIN (GETP LFHOST (QUOTE LOGIN))
(PUT LFHOST (QUOTE LOGIN)
(PROGN (PRIN1 LFHOST T)
(PRIN1 " LOGIN? " T)
(READ T]
"
TE
SE " FIL "≠
≠DIS
QUI
QUI
"))
(KFORK (SUBSYS])
(SAVE
[LAMBDA NIL
(AND (NLISTP (SYSOUT (QUOTE LARRY.SYS)))
(PROG1 (DELFILE (QUOTE LARRY.SYS))
(TENEX "EXP
"])
(CGQ
[NLAMBDA (FN)
(COPY (GETD FN])
(LISTFILES
[LAMBDA (FILLST)
[COND
((NULL FILLST)
(SETQ FILLST NOTLISTEDFILES))
((NLISTP FILLST)
(SETQ FILLST (CONS FILLST]
(PROG1 [MAPCAR FILLST (FUNCTION (LAMBDA (FIL)
(PROG1 (LISTFILE FIL)
(/DSUBST NIL FIL NOTLISTEDFILES]
(SETQ NOTLISTEDFILES (/DREMOVE NIL NOTLISTEDFILES])
(PICK
[LAMBDA (L)
(CAR (NTH L (RAND1 (LENGTH L])
(RAND1
[LAMBDA (N)
(XLATE (RAND 0.0 .999999)
N])
(ORR
[NLAMBDA L
(EVAL (PICK L])
(PAT
[LAMBDA NIL (* A pattern is a list
of at least one PATELT)
(LISTOF (PATELT)
1])
(PATELT
[LAMBDA NIL
(ORR (PATELT1)
(PATELT2)
(PATELT3)
[CONS (QUOTE ←)
(CONS (VAR)
(ORR (PATELT2)
(PATELT3]
[CONS (QUOTE ->)
(CONS (EXPRESSION)
(ORR (PATELT2)
(PATELT3]
(CONS (QUOTE !)
(ORR (PATELT1)
(PATELT3)
(CONS (QUOTE ←)
(CONS (VAR)
(PATELT3)))
(CONS (QUOTE ->)
(CONS (EXPRESSION)
(PATELT3])
(EXPRESSION
[LAMBDA (FLG)
(ORR (COND
(FLG NIL)
(T (VAR)))
(ORR (NUMBER)
(VAR))
(CONS (SETQ FLG (FNNAME))
(COND
((SUBRP FLG)
(LIST (EXPRESSION)))
((GETD FLG)
(PROG ((X 1)
LST
(MAX (NARGS FLG)))
LP [COND
((IGREATERP X MAX)
(RETURN LST))
(T (SETQ LST (NCONC1 LST (EXPRESSION]
(SETQ X (ADD1 X))
(GO LP)))
(T (LISTOF (EXPRESSION)
0 3])
(VAR
[LAMBDA NIL
(PACK (LIST (PREFIX)
(VOWEL)
(SUFFIX])
(GENPAT
[LAMBDA (STARDONE)
(PROG (VAL)
(PRINTDEF VAL←(PAT))
(TERPRI)
(RETURN VAL])
(XLATE
[LAMBDA (N1 N2)
(ADD1 (FTIMES N2 (EXPT (FDIFFERENCE N1 .999999)
2])
(LISTOF
[NLAMBDA (EXPR MIN MAX)
(PROG (VAL (MIN (OR (EVAL MIN)
0))
(MAX (OR (EVAL MAX)
10)))
(RPTQ (IPLUS MIN (RAND1 (IDIFFERENCE MAX MIN)))
(SETQ VAL (CONS (EVAL EXPR)
VAL)))
(RETURN VAL])
(NUMBER
[LAMBDA NIL
(RAND 2 10])
(FNNAME
[LAMBDA NIL
(PICK (QUOTE (NUMBERP GETD EXPRP ATOM LITATOM STRINGP NNIL ZEROP
INFILEP LISTP NLISTP MINUSP SMALLP])
(TSTPATPARSE
[LAMBDA NIL
(SETQ PAT1 (GENPAT))
(PRINT (SETQ PAT2 (UNPATPARSE PAT1)))
(PRINT (SETQ PAT3 (PARSE PAT2)))
(COND
((NOT (SETQ DIFF (DIFFER PAT1 PAT3)))
(QUOTE WIN!))
(T (QUOTE LOSE!!])
(DIFFER
[LAMBDA (L1 L2)
(COND
((OR (NLISTP L1)
(NLISTP L2))
(AND (NOT (EQUAL L1 L2))
(OR L2 L1)))
(T (PROG [(CAR (DIFFER (CAR L1)
(CAR L2)))
(CDR (DIFFER (CDR L1)
(CDR L2]
(RETURN (OR (AND CAR CDR (CONS CAR CDR))
CAR CDR])
(PATELT1
[LAMBDA NIL
(COND
(STARDONE (CONS (QUOTE DEFAULT)
(VAR)))
(T (OR (CONS (QUOTE DEFAULT)
(VAR))
(PROG1 (QUOTE *)
(SETQ STARDONE T])
(PATELT2
[LAMBDA NIL
(ORR (QUOTE $)
(QUOTE $1)
(CONS (QUOTE $$)
(ORR (NUMBER)
(EXPRESSION])
(PATELT3
[LAMBDA NIL
(ORR (CONS (QUOTE :)
(PRED))
(PAT])
(PRED
[LAMBDA NIL
(ORR (FNNAME)
(LIST (CAR (FNTH (QUOTE (EQ EQUAL))
(RAND 1 2)))
(QUOTE @)
(ORR (KWOTE (EXPRESSION))
(EXPRESSION)))
(LIST (FNNAME)
(QUOTE @])
(PATELT4
[LAMBDA NIL
(ORR (PATELT3) <'←(VAR) ! (PATELT3)> <'-> (EXPRESSION)
! (PATELT3)>])
(TMPPATELT
[LAMBDA NIL
(ORR (PATELT1)
(PATELT2)
(PATELT3)
[CONS (QUOTE ←)
(CONS (VAR)
(ORR (QUOTE $1)
(PATELT3]
(CONS (QUOTE ->)
(CONS (EXPRESSION)
(ORR (QUOTE $1)
(PATELT3])
(UNPATPARSE
[LAMBDA (PAT) (* Unpatparse each
pattern element and
NCONC values together)
(MAPCONC PAT (FUNCTION UNPATPARSELT])
(UNPATPARSELT
[LAMBDA (PATELT) (* CREATE valid input
sytax)
(PROG (TEM)
(COND
((NLISTP PATELT)
(SELECTQ PATELT
(($1 $ *)
(LIST PATELT))
(HELP (QUOTE "CAN'T UNPATPARSE")
PATELT)))
(T
(SELECTQ
(CAR PATELT)
(DEFAULT (LIST (CDR PATELT)))
[$$ (COND
((NUMBERP (CDR PAT))
(PACKRAT (QUOTE $)
(CDR PATELT)))
((NLISTP (CDR PATELT))
(PACKRAT (QUOTE $$)
(CDR PATELT)))
(T (LIST (CAR PATELT)
(CDR PATELT]
[:(COND
((NLISTP (CDR PATELT))
(PACKRAT (QUOTE :)
(CDR PATELT)))
[(EQ (CADR PATELT)
(QUOTE EQ))
(COND
[(EQ (CAR (CADDDR PATELT))
(QUOTE QUOTE))
(PACKRAT (QUOTE ')
(CADR (CADDDR PATELT]
(T (PACKRAT (QUOTE ==)
(CADR (CADDDR PATELT]
[(EQ (CADR PATELT)
(QUOTE EQUAL))
(COND
[(EQ (CAR (CADDDR PATELT))
(QUOTE QUOTE))
(PACKRAT (QUOTE ')
(CADR (CADDDR PATELT]
(T (PACKRAT (QUOTE =)
(CADR (CADDDR PATELT]
((NOT (CDDDR PATELT))
(PACKRAT (QUOTE :)
(CADR PATELT)))
(T (PACKRAT (QUOTE :)
(CDR PATELT]
[ANY (LIST (CONS (CAR PATELT)
(UNPATPARSE (CDR PATELT]
(←(NCONC [PACKRAT (CADR PATELT)
(CAR PATELT)
(CAR (SETQ TEM (UNPATPARSELT
(CDDR PATELT]
(CDR TEM)))
(-> (PACKRAT (UNPATPARSELT (CDDR PATELT))
(QUOTE ←)
(CADR PATELT)))
(! (NCONC [PACKRAT (QUOTE !)
(CAR (SETQ TEM (UNPATPARSELT
(CDR PATELT]
(CDR TEM)))
(LIST (UNPATPARSE PATELT])
(PACKRAT
[LAMBDA N
(PROG ((CNT N)
VAL ATLST)
LP (COND
((ZEROP CNT)
(RETURN (PACKRAT1 ATLST VAL)))
((NLISTP (ARG N CNT))
(SETQ ATLST (CONS (ARG N CNT)
ATLST)))
(T (SETQ VAL (CONS (ARG N CNT)
(PACKRAT1 ATLST VAL)))
(SETQ ATLST NIL)))
(SETQ CNT (SUB1 CNT))
(GO LP])
(PACKRAT1
[LAMBDA (ATLST LST)
(COND
(ATLST (CONS (PACK ATLST)
LST))
(T LST])
(TSTMATCH
[LAMBDA NIL
(USEREXEC
(QUOTE PAT?)
(APPEND
[QUOTE ([G (CAR (LISPXUNREAD (LIST (UNPATPARSE (PROG (STARDONE)
(PAT]
(GP (CAR (LISPXUNREAD (LIST (PROG (STARDONE)
(PAT']
LISPXMACROS)
(QUOTE LMUSERFN])
(LMUSERFN
[LAMBDA (PAT EXPR)
(COND
((LISTP PAT)
(OUTPUT T)
(LISPXPRINTDEF (SETQ EXPR (MAKEMATCH VARTOMATCH PAT))
1 T)
(LISPXTERPRI T)
(COND
((OPENP EXAMPLEFILE (QUOTE OUTPUT))
(OUTPUT EXAMPLEFILE)
(PRINT PAT)
(TERPRI)
(PRINTDEF EXPR)
(PRIN1 "
")))
(OUTPUT T)
(RPLACA LISPXHIST (QUOTE !))
(RETFROM (QUOTE LISPX))
T])
(PREFIX
[LAMBDA NIL
(PICK0 (QUOTE (B BR CHR CL CR D DW F FL FR G GH H J K KR L M ML N P
PL PR QU R S SCH SCHL SH SHR TH TR V W WH X Y ZR])
(SUFFIX
[LAMBDA NIL
(PICK0 (QUOTE (B CK D LD ND DE F LF G SH CH GH G K LK NK RK L LE M
RM N P RP T ST W RG])
(VOWEL
[LAMBDA NIL
(PICK0 (QUOTE (A E I O U OU OO EE])
(PICK0
[LAMBDA (L)
(CAR (NTH L (RAND 1 (LENGTH L])
)
(LISPXPRINT (QUOTE GENPATFNS)
T)
(RPAQQ GENPATFNS
(COLLECT LISTFILE SAVE CGQ LISTFILES PICK RAND1 ORR PAT PATELT
EXPRESSION VAR GENPAT XLATE LISTOF NUMBER FNNAME
TSTPATPARSE DIFFER PATELT1 PATELT2 PATELT3 PRED
PATELT4 TMPPATELT UNPATPARSE UNPATPARSELT PACKRAT
PACKRAT1 TSTMATCH LMUSERFN PREFIX SUFFIX VOWEL PICK0))
(LISPXPRINT (QUOTE GENPATVARS)
T)
(RPAQQ GENPATVARS ((FNS DE PAT' PATELT')
VARTOMATCH
(VARS (CURRENTFILE)
(HOST)
(EXAMPLEFILE (QUOTE EXAMPLES)))
(ADVISE DEFINE LOAD UNBREAK0)
[P (RELINK (QUOTE (UNBREAK]
(P (MOVD (QUOTE LISPXPRINT)
(QUOTE LISPXPRINTDEF)))
(PROP MACRO ORR LISTOF)
(ADVICE PATELT)))
(DEFINEQ
(DE
[NLAMBDA L
(DEFINE (LIST L])
(PAT'
[LAMBDA NIL
(PROG ($$VAL (X (RAND 1 THISMAX))
(THISMAX (IQUOTIENT (IPLUS THISMAX 5)
2)))
(SETQ X (RAND 1 10))
$$LP(COND
((ILESSP X 1)
(RETURN $$VAL)))
(SETQ $$VAL (NCONC $$VAL (PATELT')))
(SETQ X (IPLUS X -1))
(GO $$LP])
(PATELT'
[LAMBDA NIL
(EVAL (PICK0 (QUOTE ((LIST (QUOTE $1))
(LIST (QUOTE $))
(PACKRAT (QUOTE ==)
(EXPRESSION))
(PACKRAT (QUOTE =)
(EXPRESSION))
(PAT')
(APPEND (PACKRAT (VAR)
(QUOTE ←))
(PATELT'))
(APPEND (PATELT')
(PACKRAT (QUOTE ←)
(VAR)))
(PACKRAT (QUOTE :)
(FNNAME))
(LIST (QUOTE *))
(CONS (QUOTE !)
(PATELT'])
)
(RPAQQ VARTOMATCH var)
(RPAQ CURRENTFILE)
(RPAQ HOST)
(RPAQQ EXAMPLEFILE EXAMPLES)
(DEFLIST(QUOTE(
[DEFINE
(NIL (AFTER NIL
(AND CURRENTFILE
(MAPC !VALUE
(FUNCTION
(LAMBDA (X)
(/NCONC1
(/DREMOVE X (CAAR (FILEVARS
CURRENTFILE))
)
X]
[LOAD (NIL (BIND NIL ((CURRENTFILE]
[UNBREAK0 (NIL (AFTER NIL (SETQ LASTWORD FN]
))(QUOTE READVICE))
(READVISE DEFINE LOAD UNBREAK0)
(RELINK (QUOTE (UNBREAK)))
(MOVD (QUOTE LISPXPRINT)
(QUOTE LISPXPRINTDEF))
(DEFLIST(QUOTE(
[ORR
(L (PROG ((TEM 0))
(CONS (QUOTE SELECTQ)
(CONS (LIST (QUOTE RAND1)
(LENGTH L))
(NCONC [MAPCAR L (FUNCTION
(LAMBDA
(X)
(LIST (SETQ TEM
(ADD1 TEM))
X]
(QUOTE ((HELP]
[LISTOF
(L ([LAMBDA
(EXPR MIN MAX)
(LIST (QUOTE PROG)
(QUOTE (VAL))
(LIST (QUOTE RPTQ)
[COND [MIN (LIST (QUOTE IPLUS)
MIN
(LIST (QUOTE RAND1)
(LIST (QUOTE IDIFFERENCE)
(OR MAX 10)
MIN]
(T (LIST (QUOTE RAND1)
(OR MAX 10]
(LIST (QUOTE SETQ)
(QUOTE VAL)
(CONS (QUOTE CONS)
(CONS EXPR (QUOTE (VAL]
(CAR L)
(CADR L)
(CADDR L]
))(QUOTE MACRO))
(DEFLIST(QUOTE(
[PATELT (NIL (BEFORE NIL (RETURN (TMPPATELT]
))(QUOTE READVICE))
STOP